home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / kcl / akcl / kcl.lha / c / fasl_io.c < prev    next >
Encoding:
C/C++ Source or Header  |  1987-06-04  |  6.3 KB  |  362 lines
  1. /*
  2. (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984.  All rights reserved.
  3. */
  4.  
  5. /*
  6.     fasl_io.c
  7.     DG-SPECIFIC
  8.  
  9.     FASL loader io routines
  10. */
  11.  
  12. #include "^h:fasl.h"
  13. #include "^h:fasl_global.h"
  14. #include <sysid.h>
  15. #include <packets:normal_io.h>
  16. #include <paru.h>
  17.  
  18. P_NIO_EX    fas_io;        /* io packet for fasl file */
  19. P_NIO_EX    fas_temp;    /* io packet for temp file */
  20.  
  21. /* open fasl file */
  22. fasl_open(namep)
  23. char    *namep;        /* file name byte pointer */
  24. {
  25.     int    ac0, ac1, ac2, ier;
  26.  
  27.     if (fas_io.ich != 0 ) {
  28.     /*    ier = fasl_close();
  29.         if (ier != 0) return(ier);    */
  30.         fasl_close();
  31.         }
  32.     fas_io.isti = $ICRF | $OFIN | $RTDY;
  33.     fas_io.imrs = -1;
  34.     fas_io.ibad = -1;
  35.     fas_io.ircl = -1;
  36.     fas_io.ifnp = namep;        /* file name pointer */
  37.     fas_io.idel = -1;
  38.  
  39.     ac2 = &fas_io;
  40.     return(sys($OPEN, &ac0, &ac1, &ac2));
  41.  
  42. }
  43.  
  44. /* close FASL file */
  45. fasl_close()
  46. {
  47.     int    ac0, ac1, ac2, ier;
  48.  
  49.     ac2 = &fas_io;
  50.     ier = sys($CLOSE, &ac0, &ac1, &ac2);
  51. /*    if (ier != 0) return(ier);    ignore error */
  52.     fasl_clear_pack(&fas_io);
  53.     return(0);
  54. }
  55.  
  56. /* clear io packet */
  57. fasl_clear_pack(iopack)
  58. P_NIO_EX *iopack;
  59. {
  60.     (*iopack).ich = 0;
  61.     (*iopack).isti = 0;
  62.     (*iopack).isto = 0;
  63.     (*iopack).imrs = 0;
  64.     (*iopack).ibad = 0;
  65.     (*iopack).ires = 0;
  66.     (*iopack).ircl = 0;
  67.     (*iopack).irlr = 0;
  68.     (*iopack).irnw = 0;
  69.     (*iopack).irnh = 0;
  70.     (*iopack).ifnp = 0;
  71.     (*iopack).idel = 0;
  72.     (*iopack).etsp = 0;
  73.     (*iopack).etft = 0;
  74.     (*iopack).etlt = 0;
  75.     (*iopack).enet = 0;
  76. }
  77.  
  78. /* get next fasl block */
  79. fasl_nblock()
  80. {
  81.     int    ac0, ac1, ac2, ier;
  82.     short    block_len;    /* block length */
  83.  
  84.     fas_io.isti = $RTDY;
  85.     fas_io.ibad = fas_buffp;
  86.     fas_io.ircl = FAS_HEADER_BLEN;
  87.     fas_io.irnh = 0;
  88.  
  89.     ac2 = &fas_io;
  90.     ier = sys($READ, &ac0, &ac1, &ac2);    /* get header only */
  91. /*    if (ier != 0) return(ier);    */
  92.     if (ier != 0) sys_emes(ier);        /* not return */
  93.  
  94.     block_len = ((FAS_HDR_P)fas_buffp)->hdr_len;  /* set block len */
  95.  
  96.     /* if no block body , then return to caller */
  97.     if (block_len <= FAS_HEADER_LEN) return(0);
  98.  
  99.     /* we must read block body */
  100.  
  101.     fas_io.ibad = fas_buffp + FAS_HEADER_BLEN;
  102.     fas_io.ircl = block_len * 2 - FAS_HEADER_BLEN;
  103.  
  104.     if (fas_io.ircl > FAS_BUFF_LEN - FAS_HEADER_BLEN)
  105.         fasl_invalid();
  106.  
  107.     ac2 = &fas_io;
  108. /*    return(sys($READ, &ac0, &ac1, &ac2));    */
  109.     ier = sys($READ, &ac0, &ac1, &ac2);
  110.     if (ier != 0) sys_emes(ier);
  111. }
  112.  
  113. /* reset file position */
  114. fasl_rpos()
  115. {
  116.     int    ac0, ac1, ac2, ier;
  117.  
  118.     fas_io.isti = $IPST | $RTDY;
  119.     fas_io.irnh = 0;
  120.     fas_io.ircl = 0;
  121.  
  122.     ac2 = &fas_io;
  123. /*    return(sys($SPOS, &ac0, &ac1, &ac2));    */
  124.     ier = sys($SPOS, &ac0, &ac1, &ac2);
  125.     if (ier != 0) sys_emes(ier);
  126. }
  127.  
  128. fasl_open_temp()
  129. {
  130.     int    ac0, ac1, ac2, ier;
  131.  
  132.     get_pid();
  133.     copypid(fas_temp_name+1);
  134.  
  135.     if (fas_temp.ich != 0) {
  136.     /*    ier = fasl_close_temp();
  137.         if (ier != 0) return(ier);    */
  138.         fasl_close_temp();
  139.         }
  140.     fas_temp.isti = $OFCR | $OFCE | $ICRF | $OFIO | $RTFX;
  141.     fas_temp.imrs = -1;
  142.     fas_temp.ibad = fas_temp_buff;
  143.     fas_temp.ircl = FAS_BUFF_LEN;
  144.     fas_temp.ifnp = fas_temp_name;
  145.     fas_temp.idel = -1;
  146.  
  147.     ac2 = &fas_temp;
  148.     ier = sys($OPEN, &ac0, &ac1, &ac2);
  149.     if (ier != 0) sys_emes(ier);
  150. }
  151.  
  152. fasl_close_temp()
  153. {
  154.     int    ac0, ac1, ac2, ier;
  155.  
  156.     ac2 = &fas_temp;
  157.     ier = sys($CLOSE, &ac0, &ac1, &ac2);
  158.     fasl_clear_pack(&fas_temp);
  159.     if (ier != 0) sys_emes(ier);
  160.  
  161.     ac0 = fas_temp_name;
  162.     sys($DELETE, &ac0, &ac1, &ac2);
  163. }
  164.  
  165. fasl_read_temp(recno)
  166. int    recno;
  167. {
  168.     int    ac0, ac1, ac2, ier;
  169.  
  170.     fas_temp.isti = $IPST | $RTFX;
  171.     fas_temp.irnh = fas_temp_curr = recno;
  172.  
  173.     ac2 = &fas_temp;
  174.     ier = sys($READ, &ac0, &ac1, &ac2);
  175.     if (ier != 0) sys_emes(ier);
  176. }
  177.  
  178. fasl_write_temp()
  179. {
  180.     int    ac0, ac1, ac2, ier;
  181.  
  182.     fas_temp.isti = $IPST | $RTFX;
  183.     fas_temp.irnh = fas_temp_curr;    /* cuurent record in memory */
  184.  
  185.     ac2 = &fas_temp;
  186.     ier = sys($WRITE, &ac0, &ac1, &ac2);
  187.     if (ier != 0) sys_emes(ier);
  188. }
  189.  
  190. fasl_read_addr_rec(recno)
  191. int recno;
  192. {
  193.     int    ac0, ac1, ac2, ier;
  194.  
  195.     fas_temp.isti = $IPST | $RTFX;
  196.     fas_temp.irnh = fas_addr_rec_first + recno;
  197.     fas_temp.ibad = fas_addr_buff;
  198.  
  199.     ac2 = &fas_temp;
  200.     ier = sys($READ, &ac0, &ac1, &ac2);
  201.  
  202.     fas_temp.ibad = fas_temp_buff;
  203.  
  204.     if (ier != 0)
  205.         sys_emes(ier);
  206.  
  207.     fas_addr_rec_curr = recno;
  208. }
  209.  
  210. fasl_write_addr_rec(recno)
  211. int recno;
  212. {
  213.     int    ac0, ac1, ac2, ier;
  214.  
  215.     fas_temp.isti = $IPST | $RTFX;
  216.     fas_temp.irnh = fas_addr_rec_first + recno;
  217.     fas_temp.ibad = fas_addr_buff;
  218.  
  219.     ac2 = &fas_temp;
  220.     ier = sys($WRITE, &ac0, &ac1, &ac2);
  221.  
  222.     fas_temp.ibad = fas_temp_buff;
  223.  
  224.     if (ier != 0)
  225.         sys_emes(ier);
  226. }
  227.  
  228. /* Old one.  New one below.
  229. fasl_openst()
  230. {
  231.     int    ac0,ac1,ac2,ier;
  232.     P_NIO_EX    fas_stio;
  233.     char    st_name[256];
  234.  
  235.     get_stname(st_name);
  236.  
  237.     fasl_clear_pack(&fas_stio);
  238.  
  239.     fas_stio.ich = 0;
  240.     fas_stio.isti = $OFIN | $RTDY;
  241.     fas_stio.imrs = -1;
  242.     fas_stio.ibad = -1;
  243.     fas_stio.ircl = -1;
  244.     fas_stio.ifnp = st_name;
  245.     fas_stio.idel = -1;
  246.     fas_stio.etsp = 0;
  247.     fas_stio.etft = 0;
  248.     fas_stio.etlt = 0;
  249.  
  250.     ac2 = &fas_stio;
  251.     ier = sys($OPEN,&ac0,&ac1,&ac2);
  252.     if (ier != 0) sys_emes(ier);
  253.     fas_stchan = fas_stio.ich;
  254. }
  255. */
  256.  
  257. /* New fasl_openst for AOS/VS REV 5.03 */
  258. fasl_openst()
  259. {
  260.     int    ac0, ac1, ac2, ier;
  261.     char    st_name[256];
  262.  
  263.     get_stname(st_name);
  264.  
  265.     ac0 = st_name;
  266.     ac1 = -1;
  267.     ac2 = 0;
  268.     if(ier = sys($SOPEN, &ac0, &ac1, &ac2))
  269.         sys_emes(ier);
  270.  
  271.     fas_stchan = ac1;
  272. }
  273.  
  274.  
  275. /* get symbol value */
  276. fasl_st(symp, symv)
  277. char    *symp;        /* symbol byte pointer */
  278. int    *symv;        /* symbol value returned */
  279. {
  280.     int    ac0,ac1,ac2,ier;
  281.     int    symlen;
  282.  
  283.     for (symlen = 0; symp[symlen] != '\0'; symlen++)
  284.         ;
  285.     ac1 = (symlen << 8) | fas_stchan;
  286.     ac2 = symp;
  287.     ier = sys($GTSVL,&ac0,&ac1,&ac2);
  288.     if (ier == 0) {
  289.         *symv = ac0;
  290.         return(0);
  291.         } else
  292.         return(ier);
  293. }
  294.  
  295. get_stname(st_name)
  296. char    *st_name;
  297. {
  298.     int    i, j;
  299.     char    *cp;
  300.  
  301.     get_prname(st_name);
  302.  
  303.     for (i = 0; st_name[i] != '\0'; i++)
  304.         ;
  305.     if ((i - 3) > 0) {
  306.         cp = st_name + i - 3;
  307.         if (strcmp(cp, ".PR") == 0) i = i - 3;
  308.     }
  309.     st_name[i++] = '.';
  310.     st_name[i++] = 'S';
  311.     st_name[i++] = 'T';
  312.     st_name[i] = '\0';
  313. }
  314.  
  315. get_prname(pr_name)
  316. char    *pr_name;
  317. {
  318.     int    ac0, ac1, ac2, ier;
  319.  
  320.     ac0 = -1;
  321.     ac2 = pr_name;
  322.     ier = sys($GPRNM, &ac0, &ac1, &ac2);
  323.     if (ier != 0) sys_emes(ier);
  324. }
  325.  
  326. init_fasl_io()
  327. {
  328.     fasl_clear_pack(&fas_io);
  329.     fasl_clear_pack(&fas_temp);
  330. }
  331.  
  332. /* skip first text */
  333. fasl_skip(count)
  334. int    count;
  335. {
  336.     int    ac0, ac1, ac2, ier;
  337.     int    rec_count;
  338.  
  339.     fas_io.isti = $IPST;
  340.     fas_io.irnh = count;
  341.     ac2 = &fas_io;
  342.     if (ier = sys($SPOS, &ac0, &ac1, &ac2))
  343.         sys_emes(ier);
  344. /*
  345.     while (count > 0) {
  346.         fas_io.isti = $RTDY;
  347.         fas_io.ibad = fas_buffp;
  348.         if (count > FAS_BUFF_LEN) {
  349.             fas_io.ircl = FAS_BUFF_LEN;
  350.             count -= FAS_BUFF_LEN;
  351.         } else {
  352.             fas_io.ircl = count;
  353.             count = 0;
  354.         }
  355.  
  356.         ac2 = &fas_io;
  357.         ier = sys($READ, &ac0, &ac1, &ac2);
  358.         if (ier) sys_emes(ier);
  359.     }
  360. */
  361. }
  362.